home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1132 / dosdemo.pas < prev    next >
Pascal/Delphi Source File  |  1997-04-16  |  7KB  |  259 lines
  1.  
  2. {$ifdef windows}
  3. uses wobjects,dyna2,nnunit,wincrt,cfmtools, bpnet;
  4. {$else}
  5. uses objects,dyna2,nnunit,crt,cfmtools, bpnet;
  6. {$endif}
  7.  
  8. {$F+}
  9. label stop;
  10.  
  11. const
  12.      incount         = 2;
  13.      hidecount       = 2;
  14.      outcount        = 1;
  15.  
  16. var
  17.    max          : longint;
  18.    net          : psimpleBPnet;
  19.    i,j,k        : longint;
  20.    desiredmat   : pdynamat;
  21.    inputmat     : pdynamat;
  22.    errorvec     : pdynavec;
  23.    invec        : pdynavec;
  24.    desiredvec   : pdynavec;
  25.    linelength   : integer;
  26.    lines        : integer;
  27.    totalerror   : double;
  28.    lasterror    : double;
  29.    num          : double;
  30.    thisone      : pneuron;
  31.    data     : text;
  32.    log      : text;
  33.    stuff    : string;
  34.    learn    : double;
  35.    count    : integer;
  36.    momentum : double;
  37.    kmod     : double;
  38.    maxcount : integer;
  39.    maxerr   : double;
  40.    key      : char;
  41.    io       : pdosstream;
  42.  
  43. {-----------------------------}
  44. procedure printmattofile(var filevar: text; var mat: dynamat);
  45. {-----------------------------}
  46. var
  47.    i,j          : integer;
  48.  
  49. begin
  50.      for i := 1 to mat.nrow do
  51.       begin
  52.       for j := 1 to mat.ncol do write(filevar,mat.get(i,j):8:4 );
  53.       writeln(filevar);
  54.       end;
  55.      writeln(filevar);
  56. end;
  57.  
  58.  
  59. {              ------------- Main -----------------}
  60.  
  61.  
  62. begin
  63.                                 {Initialize stuff...}
  64.      randomize;
  65.      clrscr;
  66.      max := memavail;
  67.  
  68.      opentextfile('xor.dat',data);
  69.      if createtextfile('xor.log',log) <> 0 then halt(1);
  70.  
  71.                                    {count lines}
  72.  
  73.      readln(data,stuff);
  74.      writeln(log,stuff);
  75.      readln(data,lines,learn,momentum,kmod,maxerr,maxcount);
  76.      spacedline(log,' ');
  77.      writeln(log,lines:8,' lines  of IO data. ',#13#10,
  78.                  'Lcoeff= ',learn:8:2,
  79.                  ' Momentum= ',momentum:8:2,
  80.                  ' Kmod    = ',kmod:6:2,
  81.                  ' Maxerr= ',maxerr:8:6,
  82.                  ' Maxcount= ', maxcount:5);
  83.      spacedline(log,' ');
  84.      writeln(lines:8,' lines  of IO data. ',#13#10,
  85.                  'Lcoeff= ',learn:8:2,
  86.                  ' Momentum= ',momentum:8:2,
  87.                  ' Kmod    = ',kmod:6:2,#13,#10,
  88.                  ' Maxerr= ',maxerr:8:6,
  89.                  ' Maxcount= ', maxcount:5);
  90.  
  91.  
  92.      lines := countlines(data);
  93.      readln(data);readln(data);
  94.      linelength:= incount+outcount;
  95.  
  96.      new(desiredmat,init(lines,outcount));
  97.      new(errorvec,init(outcount,1));
  98.      new(inputmat,init(lines,linelength));
  99.  
  100.  
  101.                                 {Make Backpropnet -
  102.                                  Really simple...}
  103.  
  104.      new(net,init(incount,hidecount,outcount,learn,momentum));
  105.      net^.shake(0.8);
  106.      net^.setfieldsignal(net^.hiddenfield,sigmoid);
  107.      net^.setfieldsignal(net^.outputfield,linear);
  108.  
  109.  
  110.      printmattofile(log,net^.weights^);
  111.      printdynaerror;
  112.      printneuralerror;
  113.  
  114.                               {Get input data}
  115.  
  116.      linestomat(data,inputmat^);
  117.      writeln(log,'IO MATRIX');
  118.      printmattofile(log,inputmat^);
  119.  
  120.      for i := 1 to lines do
  121.          for j := 1 to outcount do
  122.             desiredmat^.put(i,j,inputmat^.get(i,incount+j));
  123.      writeln(log,'DESIRED MATRIX');
  124.      printmattofile(log,desiredmat^);
  125.  
  126.      for i := 1 to outcount do inputmat^.deletecol(incount+i);
  127.      writeln(log,'INPUT MATRIX');
  128.      printmattofile(log,inputmat^);
  129.  
  130.  
  131.  
  132.                     {---------- present data -------------}
  133.  
  134.      count      := 0;
  135.  
  136.      repeat
  137.        totalerror := 0;
  138.  
  139.        for j := 1 to lines do
  140.           begin
  141.           inc(count);
  142.           desiredmat^.getrow(j,desiredvec);
  143.           inputmat^.getrow(j,invec);
  144.           net^.feedforward(invec);
  145.  
  146.                                 {make error vector}
  147.  
  148.           for i := 1 to net^.outputfield^.count do
  149.               begin
  150.               thisone := net^.outputfield^.at(i-1);
  151.               lasterror := (desiredvec^.get(i) - thisone^.output);
  152.               totalerror := totalerror + abs(lasterror);
  153.               errorvec^.put(i, lasterror);
  154.               end;
  155.                                 { feed error back}
  156.  
  157.           net^.backpropall(errorvec);
  158.           net^.getdeltaweights(net^.learn,net^.momen);
  159.           end;
  160.  
  161.        if ((count mod (5*lines)) = 0) then
  162.                  writeln(log,'Event # ',count,
  163.                             totalerror:12:6);
  164.  
  165.        net^.adjustweights;
  166.  
  167.        gotoxy(1,10);
  168.        write(count:10,totalerror:20:14,net^.learn:20:10,#13);
  169.        for i:= 1 to errorvec^.count do
  170.                     errorvec^.put(i,0.0);
  171.        lasterror  := totalerror;
  172.        totalerror := 0;
  173.  
  174.  
  175.  
  176.        if keypressed then
  177.          begin
  178.          key := readkey;
  179.  
  180.          if key = 'w' then
  181.             begin
  182.             new(io,init('net.stm',stcreate));
  183.             io^.put(net);
  184.             dispose(io,done);
  185.             end;
  186.  
  187.          if key = 'r' then
  188.             begin
  189.             dispose(net,done);
  190.             new(io,init('net.stm',stopen));
  191.             net := psimplebpnet(io^.get);
  192.             dispose(io,done);
  193.             end;
  194.  
  195.          if key='s' then net^.shake(1.0);
  196.          if key='S' then net^.shake(3.0);
  197.          if key='l' then net^.learn := 0.7*net^.learn;
  198.          if key='L' then net^.learn := 1.3*net^.learn;
  199.          if key='q' then
  200.            begin
  201.            spacedline(log,'Network response: ');
  202.            for j := 1 to lines do
  203.             begin
  204.             inputmat^.getrow(j,invec);
  205.             net^.feedforward(invec);
  206.             writeln(log);
  207.             write(log,' inputvec  :');
  208.             printvec(log,80,invec^);
  209.             write(log,' response : ');
  210.             for i := 1 to net^.outputfield^.count do
  211.              write(log,pneuron(net^.outputfield^.at(i-1))^.output:8:3);
  212.             end;
  213.            writeln;
  214.            close(log);
  215.            halt(1);
  216.            end;
  217.          end;
  218.  
  219.        until (lasterror <maxerr) or (count > maxcount);
  220.  
  221.  
  222.  
  223.  
  224.  
  225.      spacedline(log,'Final Weights');
  226.      printmattofile(log,net^.weights^);
  227.  
  228.      spacedline(log,'Network response: ');
  229.      for j := 1 to lines do
  230.           begin
  231.           inputmat^.getrow(j,invec);
  232.           net^.feedforward(invec);
  233.           writeln(log);
  234.           write(log,' inputvec  :');
  235.           printvec(log,80,invec^);
  236.           write(log,' response : ');
  237.           for i := 1 to net^.outputfield^.count do
  238.              write(log,pneuron(net^.outputfield^.at(i-1))^.output:8:3);
  239.           end;
  240.           writeln;
  241.  
  242.      close(data);
  243.      close(log);
  244.  
  245. stop:
  246.  
  247.      writeln(memavail,' after initialized');
  248.      writeln;
  249.      writeln(max - memavail,' USED');
  250.  
  251.      dispose(net,done);
  252.      dispose(errorvec,done);
  253.      dispose(desiredmat,done);
  254.      dispose(inputmat,done);
  255.  
  256.      writeln;
  257.      writeln(memavail,' after cleanup ', (1.0*max-memavail):8:0,' lost');
  258.      readln;
  259. end.